home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / Misc.sea / Misc / hires-timer.lisp < prev    next >
Encoding:
Text File  |  1992-04-22  |  10.6 KB  |  282 lines  |  [TEXT/CCL2]
  1. ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: Timer; Base: 10 -*-
  2. ;*********************************************************************
  3. ;*                                                                   *
  4. ;*    PROGRAM      H I G H   R E S O L U T I O N    T I M E R        *
  5. ;*    PACKAGE      TIMER                                             *
  6. ;*                                                                   *
  7. ;*********************************************************************
  8.    ;* Author:     Alex Repenning, ralex@cs.colorado.edu              *
  9.    ;*             Copyright (c) 1992 Alex Repenning                  *
  10.    ;* Address:    Computer Science Department                        *
  11.    ;*             University of Colorado at Boulder                  *
  12.    ;*             Boulder, CO 80309-0430                             *
  13.    ;*                                                                *
  14.    ;* Filename:   hires-timer.lisp                                   *
  15.    ;* Update:     3/14/92                                            *
  16.    ;* Version:                                                       *
  17.    ;*   1.0  10/18/91 Alex Repenning                                 *
  18.    ;*   1.1   1/ 8/92 Alex: CLtL2                                    *
  19.    ;*   1.2   2/22/92 Alex & Brent Reeves: Symbolics                 *
  20.    ;* System:     Macintosh II, MCL 2.0                              *
  21.    ;* Abstract:   Not your father's TIME macro anymore.              *
  22.    ;*   Have you ever written code like:                             *
  23.    ;*     (time (dotimes (i 10000..) <some-form-to-be-timed>))       *
  24.    ;*   .. then this is for you! No more playing with the number of  *
  25.    ;*   times to call your code, measure time of an empty dotimes,   *
  26.    ;*   compilation, etc.                                            *
  27.    ;*   The whole thing started really small and got out of hand     *
  28.    ;*   big time.                                                    *
  29.    ;* Features:                                                      *
  30.    ;*   - High Resolution: gives you the time it takes to eval forms *
  31.    ;*       with a resolution much better than that of the built-in  *
  32.    ;*       TIME macro.                                              *
  33.    ;*   - Portable: Only relies on Common Lisp functionality.        *
  34.    ;*   - (Mac only) FRED Timer command: c-x c-t TIME-OF-SEXP        *
  35.    ;* Status: interesting hack                                       *
  36.    ;* How: compile the form to be tested, call it as many times as   *
  37.    ;*   required to determine the time it takes. Compare the time    *
  38.    ;*   with the time of an empty loop.                              *
  39.    ;* Bugs, Problems: It may take a while to determine the time if   *
  40.    ;*   the form to be timed is very fast (e.g., (SVREF ..)).        *
  41.    ;*                                                                *
  42.    ;******************************************************************
  43.  
  44. (defpackage TIMER
  45.   (:use "COMMON-LISP")
  46.   (:export duration))
  47.  
  48. (in-package "TIMER")
  49.  
  50. ;----------------------------------
  51. ;  Parameters                      |
  52. ;----------------------------------
  53.  
  54. (defvar *Maximum-User-Patience* 40.0 
  55.  "  Seconds. Time after which the test gets aborted.")
  56.  
  57. (defvar *Minimum-Test-Form-Run-Time* 1.0 
  58.  "  Seconds. The minimal time spent in the test form to
  59.    get acceptable results.")
  60.  
  61. (defvar *Minimum-Loop-Run-Time* 0.1
  62.  " Seconds. The minimal time spend in the loop CONTAINING the test
  63.   form to compute an upper estimate of the test form time.")
  64.  
  65. ;----------------------------------
  66. ;  Portable Code                   |
  67. ;----------------------------------
  68.  
  69. (defmacro DURATION (Form &key (Verbose t) (Print nil) (Count 5) (GC nil) Vars
  70.                          (Stream t)) "
  71.   in:  Form {t},
  72.        &key Verbose {boolean} default t; print final result,
  73.        Print {boolean} default nil; print progress,
  74.        Count {fixnum} default 4; number of times the empty loop and the
  75.          loop containing <form> get executed in one test sequence,
  76.        GC {boolean} default nil; start with a garbage collection if non-nil,
  77.        Vars {list of: {(<varname> <value>) or {varname}}; additional
  78.          variables lexically accessible to <form>,
  79.        Stream {stream} default t.
  80.   out: Result {t}, Time {float}.
  81.   Determine the time to evaluate a compiled version of <Form>. Only CL timing 
  82.   functions are used. It therefore might be necessary to evaluate <Form> 
  83.   several times in order to get an accurate time depending on the timer 
  84.   resolution."
  85.   (let ((Loopvar (gensym)) (Timesvar (gensym)))
  86.     `(time-of-form
  87.       #'(lambda (,Timesvar)
  88.           (declare (optimize (speed 3) (safety 0)))
  89.           (let ,Vars
  90.             (values
  91.              ,Form
  92.              (get-internal-real-time)
  93.              (progn 
  94.                ;lets hope non-MCL compilers will not
  95.                ; optimize the empty dotimes loop away!
  96.                (dotimes (,Loopvar ,Timesvar)
  97.          #+:symbolics (declare (ignore ,Loopvar)))
  98.                (get-internal-real-time))
  99.              (progn 
  100.                (dotimes (,Loopvar ,Timesvar)
  101.          #+:symbolics (declare (ignore ,Loopvar))
  102.          ,Form)
  103.                (get-internal-real-time)))))
  104.       ',Form
  105.       ',Verbose
  106.       ',Print
  107.       ',Count
  108.       ',GC
  109.       ',Stream)))
  110.  
  111.  
  112. (defun TIME-OF-FORM (Function Form Verbose Print Count GC Stream)
  113.   (declare (special *Minimum-Test-Form-Run-Time* *Maximum-User-Patience*
  114.                     *Minimum-Loop-Run-Time*))
  115.   (let ((Loops 1)
  116.         (Time-to-Quit (+ (get-internal-real-time)
  117.                          (* *Maximum-User-Patience*
  118.                 Internal-Time-Units-Per-Second)))
  119.         (Time 0)
  120.         (Code-Time 0)
  121.         (Iterations 0)
  122.         Result)
  123.     (when GC (garbage-collection))
  124.     ;; some Lisp systems compile automatically
  125.     ; compiled-function-p of a compiled lexical closures returns nil
  126.     ; in MCL 2.0b1p3. Bug?
  127.     (unless 
  128.       #-:ccl (compiled-function-p Function)
  129.       #+:ccl ccl:*Compile-Definitions* 
  130.       (setq Function (compile nil Function)))
  131.     ; if there is a problem in the form to be tested you better know it soon..
  132.     (setq Result (funcall Function 0))
  133.     (loop
  134.       (dotimes (I Count)
  135.     #+:symbolics (declare (ignore I))
  136.         (multiple-value-bind (Form T0 T1 T2) (funcall Function Loops)
  137.           (declare (ignore Form) (fixnum T0 T1 T2))
  138.           (incf Code-Time (- T2 T1))
  139.           (incf Time (- T2 T1 (- T1 T0)))))
  140.       (incf Iterations (* Loops Count)) 
  141.       (let ((STime (/ Time Internal-Time-Units-Per-Second))
  142.             (SCode-Time (/ Code-Time Internal-Time-Units-Per-Second)))
  143.         (cond
  144.          ((> (get-internal-real-time) Time-to-Quit)
  145.           ; Time to quit!
  146.           (when Verbose
  147.             (format Stream "~&Iterations: ~6D  Time: < " Iterations)
  148.             (print-time (/ SCode-Time Iterations) Stream))
  149.           (return (values Result (float (/ STime Iterations)) Function)))
  150.          ((< STime *Minimum-Test-Form-Run-Time*)
  151.           ; the result is not good enough (noise and/or timer resolution)
  152.           (when Print
  153.             (format Stream "~&Iterations: ~6D" Iterations)
  154.             (when (> SCode-Time *Minimum-Loop-Run-Time*)
  155.               (format Stream "  Time: < ")
  156.               (print-time (/ SCode-Time Iterations) Stream)))
  157.           (setq Loops (* Loops 2)))
  158.          (t ; determined the time
  159.           (when Verbose
  160.             (format Stream "~&Iterations: ~D, Time: " Iterations)
  161.             (print-time (/ STime Iterations) Stream)
  162.             (format Stream ", Form: ~A " Form))
  163.           (return (values Result (float (/ STime Iterations)) Function))))))))
  164.  
  165.  
  166.  
  167. (defun PRINT-TIME (Time &optional (S t))
  168.   "
  169.   in:  Time {float} time in seconds,
  170.        &optional S {stream} default t.
  171.   Print <Time> using s, ms, us, or ns representation."
  172.   (if (zerop time)
  173.     (format S "~E seconds" Time)
  174.     (let ((E (/ (log (abs Time)) #.(log 10))))
  175.       (cond
  176.        ((> E 0)  (format S "~E seconds" Time))
  177.        ((> E -3) (format S "~6,2F ms" (* Time 1e3)))
  178.        ((> E -6) (format S "~6,2F us" (* Time 1e6)))
  179.        ((> E -9) (format S "~6,2F ns" (* Time 1e9)))
  180.        (t (format S "~E seconds" Time))))))
  181.  
  182.  
  183. (defun GARBAGE-COLLECTION ()
  184.   #+:coral (ccl:gc) 
  185.   #+:allegro (excl:gc))
  186.  
  187. ;-------------------------
  188. ;  MCL only               |
  189. ;-------------------------
  190. #+:mcl
  191. (defmethod TIME-OF-SEXP ((Self ccl:fred-mixin)) "
  192.   in: Self {fred-mixin}."
  193.   (let ((*Package* (or (ccl:window-package Self) *Package*))
  194.         (Stream (ccl::view-mini-buffer Self)))
  195.     (eval `(duration ; ok, I could have done without eval..
  196.             ,(ccl:buffer-current-sexp (ccl:fred-buffer Self))
  197.             :stream ,Stream))
  198.     (ccl:window-select Self)))
  199.  
  200. #+:mcl
  201. (ccl:comtab-set-key ccl:*Control-X-Comtab* '(:control #\t) 'time-of-sexp)
  202.  
  203.  
  204.  
  205. #| Examples (times are on a MacII, using MCL 2.0b1p3):
  206.  
  207. Arithmetic
  208. ==========
  209.  
  210. (duration (sin 5.0))                    ; 77 us amazing; this get not optimized!
  211. (duration (sin x) :vars ((x 5.0)))      ; 78 us 
  212. (duration (sin pi))                     ; 63 us  hmmm..
  213. ; the :print keyword will show intermediate steps
  214. (duration (+ 5 6) :print t)             ; 110 ns well optimized - just put 11 on stack
  215.  
  216. (duration (+ a b) :vars ((a 5) (b 6)) :print t)   ; 1.7 us  that's more like it
  217.  
  218. Array Access
  219. ============
  220.  
  221. (setq a (make-array 10))
  222.  
  223. (duration (aref a 3))                   ; 19 us
  224. (duration (svref a 3))                  ;  7 us better but still slow
  225.  
  226. local variables
  227. ---------------
  228.  
  229. (duration (svref a 3) :vars ((a a)) :print t)   ; 500 ns !!!
  230. ; accessing the global non-special variable a was more than 10 times
  231. ; slower than the actual array access!
  232.  
  233. (defvar a2 a)
  234.  
  235. (duration (svref a2 3))                 ; 1 us 
  236. ; accessing special variables is much faster
  237.  
  238. (duration (aref a 3) :vars ((a a)))     ; 13 us
  239.  
  240. (duration (ccl::%svref a 3) :vars ((a a)))   ; 500 ns
  241.  
  242. ;******* The Art of Noise *************
  243.  
  244. (defvar *Noise* nil)
  245.  
  246. #-:ccl
  247. (defun RECORD-NOISE (N)
  248.   (setq *Noise* nil)
  249.   (let* ((Start-Time (get-internal-real-time))
  250.          (Time (progn (should-take-constant-time)
  251.                       (- (get-internal-real-time) Start-Time))))
  252.     (dotimes (I N)
  253.       (let* ((Start-Time (get-internal-real-time))
  254.              (New-Time (progn (should-take-constant-time)
  255.                               (- (get-internal-real-time) Start-Time))))
  256.         (push (- New-Time Time) *Noise*)))))
  257.  
  258.  
  259. #+:ccl
  260. (defun RECORD-NOISE (N)
  261.   (setq *Noise* nil)
  262.   (let* (Time)
  263.     (ccl:time-code Time  (should-take-constant-time))
  264.     (dotimes (I N)
  265.       (let* (New-Time)
  266.         (ccl:time-code New-Time  (should-take-constant-time))
  267.         (push (- New-Time Time) *Noise*)))))
  268.  
  269. (time (record-noise 100))
  270.  
  271. (plot-noise)
  272.  
  273. (defun PLOT-NOISE ()
  274.   (dolist (I *Noise*) (print I)))
  275.         
  276.  
  277. (defun SHOULD-TAKE-CONSTANT-TIME ()
  278.   (dotimes (I 1000)))
  279.  
  280. |#
  281.  
  282.